unit nhibDataset;

interface
uses Classes, SysUtils, DB, Variants, Forms, UMono, UMonoIntf, UVarMono,
 StrUtils, Generics.Collections, Dialogs;

type
  TNhibRecord = packed record
    Bookmark: integer;
    BookmarkFlag: TBookmarkFlag;
    Data: integer;
  end;
  PNhibRecord = ^TNhibRecord;

  TNhibList = class;
  TNhibObject = class;

  TMonoDataset = class(TDataSet)
  protected
    FIndexList: integer;
    FIsOpen: boolean;
    FNhibList: TNhibList;
    FStartCalculated: Integer;
  protected
    function GetObjRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    procedure InternalClose; override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalOpen; override;
    function IsCursorOpen: Boolean; override;

    function AllocRecordBuffer: TRecordBuffer; override;
    procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
    procedure InternalInitRecord(Buffer: TRecordBuffer); override;

    function GetRecordCount: Integer; override;
    function GetRecordSize: Word; override;
    function GetRecNo: Integer; override;
    procedure SetRecNo(Value: Integer); override;

    procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: TRecordBuffer): TBookMarkFlag; override;
    procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
    procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookMarkFlag); override;
    procedure InternalGotoBookmark(BookMark: Pointer); override;
    procedure InternalSetToRecord(Buffer: TRecordBuffer); override;

    procedure InternalInsert; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalLast; override;

    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  public
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  end;

  TNhibernateDataset = class(TMonoDataset)
  private
    function getCurrentObject: variant;
    function getMonoAssemblyName: string;
    function getMonoTypeName: string;
    function getSourceList: variant;
    procedure setMonoAssemblyName(const Value: string);
    procedure setMonoTypeName(const Value: string);
    procedure setSourceList(const Value: variant);
  public
    property CurrentObject: variant read getCurrentObject;
    property SourceList: variant read getSourceList write setSourceList;
  published
    property MonoTypeName: string read getMonoTypeName write setMonoTypeName;
    property MonoAssemblyName: string read getMonoAssemblyName write setMonoAssemblyName;
  end;

  TNhibList = class(TObject)
  private
    FObjList: Variant;
    FMonoClass: PMonoClass;
    FMonoTypeName: string;
    FMonoAssemblyName: string;
    FList_Add: Pointer;
    FList_Count: Pointer;
    FList_GetItem: Pointer;
    FList_RemoveAt: Pointer;
    FList_Insert: Pointer;
    FList_setItem: Pointer;
    FItemObject: TNhibObject;
    FMonoDomain: PMonoDomain;
    function GetMonoObj: PMonoObject;
    procedure setMonoClass(const Value: PMonoClass);
    procedure AssignMethodPtr;
    procedure TestMonoException(error: PMonoObject); inline;
    procedure setObjList(const Value: variant);
  public
    function Count: integer;
    procedure Add(aItem: PMonoObject);
    function GetItem(aIndex: integer): PMonoObject;
    procedure Insert(aIndex: integer; aItem: PMonoObject);
    procedure RemoveAt(aIndex: integer);
    procedure SetItem(aIndex: integer; aItem: PMonoObject);

    procedure CreateObjList;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    property ObjList: variant read FObjList write setObjList;
    property MonoDomain: PMonoDomain read FMonoDomain;
    property MonoClass: PMonoClass read FMonoClass write setMonoClass;
    property MonoTypeName: string read FMonoTypeName write FMonoTypeName;
    property MonoAssemblyName: string read FMonoAssemblyName write FMonoAssemblyName;
    property ItemObject: TNhibObject read FItemObject;
  end;

  TMonoPropRec = record
    PropName: string;
    PropData: PMonoProperty;
    PropType: TMonoTypeEnum;
    MonoType: PMonoType;
    Nullable: boolean;
    ValueType: PMonoType;
    getProc: Pointer;
    setProc: Pointer;
  end;

  TNhibObject = class(TObject)
  private
    FMonoClass: PMonoClass;
    FPropList: TList<TMonoPropRec>;
    FMonoDomain: PMonoDomain;
    procedure setMonoClass(const Value: PMonoClass);
  protected
    procedure TestMonoException(error: PMonoObject); inline;
    function Read_I1(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_U1(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_I2(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_U2(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_I4(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_U4(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_I8(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_U8(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_R4(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_R8(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_Bool(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    function Read_String(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; aDataSize: integer): boolean;
    function Read_DateTime(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean): boolean;
    procedure Write_I1(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_U1(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_I2(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_U2(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_I4(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_U4(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_I8(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_U8(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_R4(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_R8(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_Bool(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
    procedure Write_String(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; aDataSize: integer);
    procedure Write_DateTime(proc: Pointer; obj: PMonoObject; Buffer: TRecordBuffer; Nullable: boolean);
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    procedure LoadProps;
    procedure InitFieldDefs(aFieldDefs: TFieldDefs);

    function ReadData(Prop: TMonoPropRec; obj: PMonoObject; Field: TField; Buffer: TRecordBuffer): boolean;
    procedure WriteData(Prop: TMonoPropRec; obj: PMonoObject; Field: TField; Buffer: TRecordBuffer);

    function NewItem: PMonoObject;

    property MonoClass: PMonoClass read FMonoClass write setMonoClass;
    property MonoDomain: PMonoDomain read FMonoDomain;
  end;

implementation

type
  TMList_Add = procedure (this: PMonoObject; aItem: PMonoObject; var exc:PMonoObject); stdcall;
  TMList_Count = function (this: PMonoObject; var exc:PMonoObject): integer; stdcall;
  TMList_GetItem = function (this: PMonoObject; aIndex: integer; var exc:PMonoObject): PMonoObject; stdcall;
  TMList_RemoveAt = procedure (this: PMonoObject; aIndex: integer; var exc: PMonoObject); stdcall; // RemoveAt (int)
  TMList_Insert = procedure (this: PMonoObject; aIndex: integer; aItem: PMonoObject; var exc: PMonoObject); stdcall; // Insert (int,Namespace.Class)
  TMList_setItem = procedure (this: PMonoObject; aIndex: integer; aItem: PMonoObject; var exc: PMonoObject); stdcall; // set_Item (int,Namespace.Class)


  TMPropGetI1 = function (this: PMonoObject; var exc:PMonoObject): ShortInt; stdcall;
  TMPropSetI1 = procedure (this: PMonoObject; aValue: ShortInt; var exc:PMonoObject); stdcall;
  TMPropGetU1 = function (this: PMonoObject; var exc:PMonoObject): byte; stdcall;
  TMPropSetU1 = procedure (this: PMonoObject; aValue: byte; var exc:PMonoObject); stdcall;
  TMPropGetI2 = function (this: PMonoObject; var exc:PMonoObject): SmallInt; stdcall;
  TMPropSetI2 = procedure (this: PMonoObject; aValue: SmallInt; var exc:PMonoObject); stdcall;
  TMPropGetU2 = function (this: PMonoObject; var exc:PMonoObject): word; stdcall;
  TMPropSetU2 = procedure (this: PMonoObject; aValue: word; var exc:PMonoObject); stdcall;
  TMPropGetI4 = function (this: PMonoObject; var exc:PMonoObject): integer; stdcall;
  TMPropSetI4 = procedure (this: PMonoObject; aValue: integer; var exc:PMonoObject); stdcall;
  TMPropGetU4 = function (this: PMonoObject; var exc:PMonoObject): cardinal; stdcall;
  TMPropSetU4 = procedure (this: PMonoObject; aValue: cardinal; var exc:PMonoObject); stdcall;
  TMPropGetI8 = function (this: PMonoObject; var exc:PMonoObject): int64; stdcall;
  TMPropSetI8 = procedure (this: PMonoObject; aValue: int64; var exc:PMonoObject); stdcall;
  TMPropGetU8 = function (this: PMonoObject; var exc:PMonoObject): uint64; stdcall;
  TMPropSetU8 = procedure (this: PMonoObject; aValue: uint64; var exc:PMonoObject); stdcall;
  TMPropGetR4 = function (this: PMonoObject; var exc:PMonoObject): single; stdcall;
  TMPropSetR4 = procedure (this: PMonoObject; aValue: single; var exc:PMonoObject); stdcall;
  TMPropGetR8 = function (this: PMonoObject; var exc:PMonoObject): double; stdcall;
  TMPropSetR8 = procedure (this: PMonoObject; aValue: double; var exc:PMonoObject); stdcall;
  TMPropGetBool = function (this: PMonoObject; var exc:PMonoObject): WordBool; stdcall;
  TMPropSetBool = procedure (this: PMonoObject; aValue: WordBool; var exc:PMonoObject); stdcall;
  TMPropGetString = function (this: PMonoObject; var exc:PMonoObject): PMonoString; stdcall;
  TMPropSetString = procedure (this: PMonoObject; aValue: PMonoString; var exc:PMonoObject); stdcall;
  TMPropGetDT = function (this: PMonoObject; var exc:PMonoObject): PMonoObject; stdcall;
  TMPropSetDT = procedure (this: PMonoObject; aValue: PMonoObject; var exc:PMonoObject); stdcall;
  TMPropGetNullable = function (this: PMonoObject; var exc:PMonoObject): PMonoObject; stdcall;
  TMPropSetNullable = procedure (this: PMonoObject; aValue: PMonoObject; var exc:PMonoObject); stdcall;

{ TNhibernateDataset }

function TMonoDataset.AllocRecordBuffer: TRecordBuffer;
begin
  Result := AllocMem(RecordSize);
end;

constructor TMonoDataset.Create(AOwner: TComponent);
begin
  inherited;
  FIndexList := -1;
  FIsOpen := false;
  FNhibList := TNhibList.Create;
  BookMarkSize := SizeOf(TNhibRecord);
  FStartCalculated := BookMarkSize;
end;

destructor TMonoDataset.Destroy;
begin
  FNhibList.Free;
  inherited;
end;

procedure TMonoDataset.FreeRecordBuffer(var Buffer: TRecordBuffer);
begin
  FreeMem(Buffer);
end;

procedure TMonoDataset.GetBookmarkData(Buffer: TRecordBuffer;
  Data: Pointer);
begin
  if Assigned(Data) then
    Move(PNhibRecord(Buffer)^, Data^, BookMarkSize);
end;

function TMonoDataset.GetBookmarkFlag(
  Buffer: TRecordBuffer): TBookMarkFlag;
begin
  Result:= PNhibRecord(Buffer)^.BookMarkFlag;
end;

function TMonoDataset.GetFieldData(Field: TField;
  Buffer: Pointer): Boolean;
var
  RecBuffer: PNhibRecord;
begin
  RecBuffer := PNhibRecord(ActiveBuffer);
  result := FNhibList.ItemObject.ReadData(FNhibList.ItemObject.FPropList[Field.Index], FNhibList.GetItem(RecBuffer^.Data), Field, Buffer );
end;

function TMonoDataset.GetObjRecord(Buffer: TRecordBuffer;
  GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin
  Result := grError;
  try
    if (not VarIsEmpty(FNhibList.FObjList)) and (FNhibList.Count > 0) then
    begin
      Result:= grOK;
      case GetMode of
        gmNext:
          begin
            if (FIndexList + 1) < FNhibList.Count then
              inc(FIndexList)
            else
              Result:= grEOF;
          end;
        gmPrior:
          begin
            if FIndexList > 0 then
              dec(FIndexList)
            else
              Result:= grBOF;
          end;
        gmCurrent:
          begin
            if FIndexList < 0 then
              Result:= grBOF;

            if FIndexList >= (FNhibList.Count) then
              Result:= grEOF;
          end;
      end;
    end;

    if Result = grOK then
    begin
      PNhibRecord(Buffer)^.BookmarkFlag := bfCurrent;
      PNhibRecord(Buffer)^.Data := FIndexList;

      if CalcFieldsSize > 0 then
        GetCalcFields(Buffer);
    end;
  except
    Result:= grError;
    if DoCheck then
      raise;
  end;
end;

function TMonoDataset.GetRecNo: Integer;
begin
  UpdateCursorPos;
  if (FIndexList = -1) and (RecordCount > 0) then
    Result := 1
  else
    Result := FIndexList + 1;
end;

function TMonoDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
begin
  //todo: filter
  result := GetObjRecord(Buffer, GetMode, DoCheck);
end;

function TMonoDataset.GetRecordCount: Integer;
begin
  if not VarIsEmpty(FNhibList.ObjList) then
    result := FNhibList.Count
  else
    result := -1;
end;

function TMonoDataset.GetRecordSize: Word;
begin
  Result := BookMarkSize + CalcFieldsSize;
end;

procedure TMonoDataset.InternalClose;
begin
  BindFields(False);

  if DefaultFields then
    DestroyFields;

  FIsOpen := False;
end;

procedure TMonoDataset.InternalDelete;
var
  p: PNhibRecord;
begin
  p := PNhibRecord(ActiveBuffer);
  FNhibList.RemoveAt(p^.Data);
end;

procedure TMonoDataset.InternalFirst;
begin
  FIndexList:= -1;
  RecNo:= 0;
end;

procedure TMonoDataset.InternalGotoBookmark(BookMark: Pointer);
begin
  FIndexList := PNhibRecord(BookMark)^.Data;
end;

procedure TMonoDataset.InternalHandleException;
begin
  Application.HandleException(Self);
end;

procedure TMonoDataset.InternalInitFieldDefs;
begin
  FNhibList.ItemObject.InitFieldDefs(FieldDefs);
end;

procedure TMonoDataset.InternalInitRecord(Buffer: TRecordBuffer);
var
  Data: TNhibRecord;
begin
  GetBookMarkdata(Buffer, @Data);
  FillChar(Buffer^, RecordSize, 0);
  SetBookMarkdata(Buffer, @Data);
end;

procedure TMonoDataset.InternalInsert;
var
  RecBuffer: PNhibRecord;
  lAppend: boolean;
  lobj: PMonoObject;
  lIndex: integer;
begin
  RecBuffer := PNhibRecord(ActiveBuffer);
  lAppend := RecBuffer^.BookmarkFlag = bfEOF;

  if FIsOpen then
  begin
    lObj := FNhibList.ItemObject.NewItem;
    if lAppend then
    begin
      lIndex := GetRecordCount;
      FNhibList.Add(lObj);
      RecBuffer^.Data := lIndex;
    end
    else begin
      FNhibList.Insert(FIndexList, lObj);
      RecBuffer^.Data := FIndexList;
      lIndex := FIndexList;
      Resync([]);
      FIndexList := lIndex;
    end;
  end;
end;

procedure TMonoDataset.InternalLast;
begin
  FIndexList := RecordCount;
  RecNo:= RecordCount;
end;

procedure TMonoDataset.InternalOpen;
begin
  InternalInitFieldDefs;
  if DefaultFields then
    CreateFields;
  BindFields(true);
  FIndexList := -1;
  FIsOpen := true;
end;

procedure TMonoDataset.InternalSetToRecord(Buffer: TRecordBuffer);
begin
  InternalGotoBookMark(Buffer);
end;

function TMonoDataset.IsCursorOpen: Boolean;
begin
  Result := FIsOpen;
end;

procedure TMonoDataset.SetBookmarkData(Buffer: TRecordBuffer;
  Data: Pointer);
begin
  if Assigned(Data) then
    Move(Data^, PNhibRecord(Buffer)^, BookMarkSize);
end;

procedure TMonoDataset.SetBookmarkFlag(Buffer: TRecordBuffer;
  Value: TBookMarkFlag);
begin
  PNhibRecord(Buffer)^.BookMarkFlag := Value;
end;

procedure TMonoDataset.SetFieldData(Field: TField; Buffer: Pointer);
var
  RecBuffer: PNhibRecord;
begin
  RecBuffer := PNhibRecord(ActiveBuffer);
  if Assigned(RecBuffer) then
    FNhibList.ItemObject.WriteData(FNhibList.ItemObject.FPropList[Field.Index], FNhibList.GetItem(RecBuffer^.Data), Field, Buffer );
  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
    DataEvent(deFieldChange, Longint(Field));
end;

procedure TMonoDataset.SetRecNo(Value: Integer);
begin
  if (Value > 0) and (Value < RecordCount) then
  begin
    FIndexList := Value - 1;
    Resync([]);
  end;
end;

{ TNhibernateDataset }

function TNhibernateDataset.getCurrentObject: variant;
var
  p: PNhibRecord;
begin
  p := PNhibRecord(ActiveBuffer);
  if assigned(p) then
    result := MonoObj2V(FNhibList.GetItem(p^.Data))
  else
    result := Null;
end;

function TNhibernateDataset.getMonoAssemblyName: string;
begin
  result := FNhibList.MonoAssemblyName;
end;

function TNhibernateDataset.getMonoTypeName: string;
begin
  result := FNhibList.MonoTypeName;
end;

function TNhibernateDataset.getSourceList: variant;
begin
  result := FNhibList.ObjList;
end;

procedure TNhibernateDataset.setMonoAssemblyName(const Value: string);
begin
  FNhibList.MonoAssemblyName := Value;
end;

procedure TNhibernateDataset.setMonoTypeName(const Value: string);
begin
  FNhibList.MonoTypeName := Value;
end;

procedure TNhibernateDataset.setSourceList(const Value: variant);
begin
  FNhibList.ObjList := value;
end;

{ TNhibList }

procedure TNhibList.Add(aItem: PMonoObject);
var
  e: PMonoObject;
begin
  TMList_Add(FList_Add)(GetMonoObj, aItem, e);
  TestMonoException(e);
end;

procedure TNhibList.AfterConstruction;
begin
  inherited;
  FItemObject := TNhibObject.Create;
end;

procedure TNhibList.AssignMethodPtr;
var
  m: PMonoMethod;
  t: PMonoType;
  sType: string;
begin
  if FMonoClass <> nil then
  begin
    m := MonoJit.FindMonoMethod(FMonoClass, 'get_Item', 'int');
    FList_GetItem := mono_method_get_unmanaged_thunk(m);
    t := mono_signature_get_return_type(mono_method_signature(m));
    sType := UTF8ToUnicodeString( mono_type_get_name(t));
    m := MonoJit.FindMonoMethod(FMonoClass, 'Add', sType);
    FList_Add := mono_method_get_unmanaged_thunk(m);
    m := MonoJit.FindMonoMethod(FMonoClass, 'get_Count', '');
    FList_Count := mono_method_get_unmanaged_thunk(m);
    m := MonoJit.FindMonoMethod(FMonoClass, 'set_Item', 'int,'+sType);
    FList_setItem := mono_method_get_unmanaged_thunk(m);
    m := MonoJit.FindMonoMethod(FMonoClass, 'RemoveAt', 'int');
    FList_RemoveAt := mono_method_get_unmanaged_thunk(m);
    m := MonoJit.FindMonoMethod(FMonoClass, 'Insert', 'int,'+sType);
    FList_Insert := mono_method_get_unmanaged_thunk(m);

    FItemObject.MonoClass := MonoJit.FindMonoClass(ExtractNameSpace(sType), ExcludeNameSpace(sType));
  end;
end;

procedure TNhibList.BeforeDestruction;
begin
  inherited;
  FItemObject.Free;
end;

function TNhibList.Count: integer;
var
  e: PMonoObject;
begin
  result := TMList_Count(FList_Count)(GetMonoObj, e);
  TestMonoException(e);
end;

procedure TNhibList.CreateObjList;
var
  lProxyClass: PMonoClass;
  lObj: PMonoObject;
  lTypeName: string;
begin
  lProxyClass := MonoJit.FindMonoClass(DefaultProxyNameSpace, DefaultProxyClassName);
  if FMonoAssemblyName <> '' then
    lTypeName := '['+FMonoTypeName+', '+FMonoAssemblyName+']'
  else
    lTypeName := FMonoTypeName;

  lObj := MonoJit.CallMonoMethod(MonoJit.FindMonoMethod(lProxyClass, 'CreateGenericType', 'string'), nil, ['System.Collections.Generic.List`1['+lTypeName+']'], MonoDomain);
  ObjList := MonoObj2V(lObj);
end;

function TNhibList.GetItem(aIndex: integer): PMonoObject;
var
  e: PMonoObject;
begin
  result := TMList_GetItem(FList_GetItem)(GetMonoObj, aIndex, e);
  TestMonoException(e);
end;

function TNhibList.GetMonoObj: PMonoObject;
begin
  result := V2MonoObject(FObjList);
end;

procedure TNhibList.Insert(aIndex: integer; aItem: PMonoObject);
var
  e: PMonoObject;
begin
  TMList_Insert(FList_Insert)(GetMonoObj, aIndex, aItem, e);
  TestMonoException(e);
end;

procedure TNhibList.RemoveAt(aIndex: integer);
var
  e: PMonoObject;
begin
  TMList_RemoveAt(FList_RemoveAt)(GetMonoObj, aIndex, e);
  TestMonoException(e);
end;

procedure TNhibList.SetItem(aIndex: integer; aItem: PMonoObject);
var
  e: PMonoObject;
begin
  TMList_setItem(FList_setItem)(GetMonoObj, aIndex, aItem, e);
  TestMonoException(e);
end;

procedure TNhibList.setMonoClass(const Value: PMonoClass);
begin
  FMonoClass := Value;
  AssignMethodPtr;
end;

procedure TNhibList.setObjList(const Value: variant);
var
  o: PMonoObject;
begin
  FObjList := Value;
  if VarIsType(Value, VarMono) then
  begin
    o := GetMonoObj;
    MonoClass := mono_object_get_class(o);
    FMonoDomain := mono_object_get_domain(o);
    FItemObject.FMonoDomain := self.FMonoDomain;
  end;
end;

procedure TNhibList.TestMonoException(error: PMonoObject);
begin
  if error <> nil then
     raise Exception.Create(MonoJit.MonoExceptionMessage(error));
end;

{ TNhibObject }

procedure TNhibObject.AfterConstruction;
begin
  inherited;
  FPropList := TList<TMonoPropRec>.Create();
end;

procedure TNhibObject.BeforeDestruction;
begin
  inherited;
  FPropList.Free;
end;

procedure TNhibObject.InitFieldDefs(aFieldDefs: TFieldDefs);
var
  elem: TMonoPropRec;
begin
  aFieldDefs.Clear;
  for elem in FPropList do
  begin
    case elem.PropType of
      MONO_TYPE_BOOLEAN:
        aFieldDefs.Add(elem.PropName, ftBoolean);
      MONO_TYPE_I1:
        aFieldDefs.Add(elem.PropName, ftShortint);
      MONO_TYPE_U1:
        aFieldDefs.Add(elem.PropName, ftByte);
      MONO_TYPE_I2:
        aFieldDefs.Add(elem.PropName, ftSmallint);
      MONO_TYPE_U2:
        aFieldDefs.Add(elem.PropName, ftWord);
      MONO_TYPE_I4:
        aFieldDefs.Add(elem.PropName, ftInteger);
      MONO_TYPE_U4:
        aFieldDefs.Add(elem.PropName, ftLongWord);
      MONO_TYPE_I8, MONO_TYPE_U8:
        aFieldDefs.Add(elem.PropName, ftLargeint);
      MONO_TYPE_R4:
        aFieldDefs.Add(elem.PropName, ftSingle);
      MONO_TYPE_R8:
        aFieldDefs.Add(elem.PropName, ftFloat);
      MONO_TYPE_STRING:
        aFieldDefs.Add(elem.PropName, ftWideString, 200);   //todo: fieldsize
      MONO_TYPE_VALUETYPE:
        if elem.MonoType = TMonoConvert.DateTimeType then
        begin
          aFieldDefs.Add(elem.PropName, ftDateTime);
        end;
      MONO_TYPE_GENERICINST:
        begin
          if StartsText('System.Nullable', UTF8ToString(mono_type_get_name(elem.MonoType))) then
          begin
            case mono_type_get_type(elem.ValueType) of
              MONO_TYPE_BOOLEAN:
                aFieldDefs.Add(elem.PropName, ftBoolean);
              MONO_TYPE_I1:
                aFieldDefs.Add(elem.PropName, ftShortint);
              MONO_TYPE_U1:
                aFieldDefs.Add(elem.PropName, ftByte);
              MONO_TYPE_I2:
                aFieldDefs.Add(elem.PropName, ftSmallint);
              MONO_TYPE_U2:
                aFieldDefs.Add(elem.PropName, ftWord);
              MONO_TYPE_I4:
                aFieldDefs.Add(elem.PropName, ftInteger);
              MONO_TYPE_U4:
                aFieldDefs.Add(elem.PropName, ftLongWord);
              MONO_TYPE_I8, MONO_TYPE_U8:
                aFieldDefs.Add(elem.PropName, ftLargeint);
              MONO_TYPE_R4:
                aFieldDefs.Add(elem.PropName, ftSingle);
              MONO_TYPE_R8:
                aFieldDefs.Add(elem.PropName, ftFloat);
              MONO_TYPE_VALUETYPE:
                //if elem.ValueType = TMonoConvert.DateTimeType then
                if UTF8ToString(mono_type_get_name(elem.ValueType)) = 'System.DateTime' then
                begin
                  aFieldDefs.Add(elem.PropName, ftDateTime);
                end;
            end;
          end;
        end;
    end;

  end;
end;

procedure TNhibObject.LoadProps;
var
  iter: Pointer;
  lKlass: PMonoClass;
  mp: PMonoProperty;
  m: PMonoMethod;
  lProp: TMonoPropRec;
  lType: PMonoType;
  lPropType: TMonoTypeEnum;

  function IsPropTypeSupported(aType: PMonoType; aTypeEnum: TMonoTypeEnum): boolean;
  begin
    result := aTypeEnum in [MONO_TYPE_BOOLEAN, MONO_TYPE_I1, MONO_TYPE_U1,
       MONO_TYPE_I2, MONO_TYPE_U2, MONO_TYPE_I4, MONO_TYPE_U4,
       MONO_TYPE_I8, MONO_TYPE_U8, MONO_TYPE_R4, MONO_TYPE_R8,
       MONO_TYPE_STRING];
    if not result then
    begin
      if aTypeEnum = MONO_TYPE_VALUETYPE then
        result := (aType = TMonoConvert.DateTimeType);
      if aTypeEnum = MONO_TYPE_GENERICINST then
        result := StartsText('System.Nullable', UTF8ToString(mono_type_get_name(aType)));
    end;
  end;

begin
  FPropList.Clear;
  lKlass := MonoClass;
  while lKlass <> nil do
  begin
    iter := nil;
    mp := mono_class_get_properties(lKlass, iter);
    while mp <> nil do
    begin
      m := mono_property_get_get_method(mp);
      if m <> nil then
      begin
        lType := mono_signature_get_return_type(mono_method_signature(m));
        lPropType := mono_type_get_type(lType);
        if IsPropTypeSupported(lType, lPropType) then
        begin
          lProp.PropName := UTF8ToUnicodeString(mono_property_get_name(mp));
          lProp.PropData := mp;
          lProp.PropType := lPropType;
          lProp.MonoType := lType;
          lProp.getProc := mono_method_get_unmanaged_thunk(m);
          m := mono_property_get_set_method(mp);
          if m <> nil then
            lProp.setProc := mono_method_get_unmanaged_thunk(m)
          else
            lProp.setProc := nil;
          lProp.ValueType := lType;
          lProp.Nullable := false;
          if lPropType = MONO_TYPE_GENERICINST then
            if StartsText('System.Nullable', UTF8ToString(mono_type_get_name(lType))) then
            begin
              lProp.Nullable := true;
              lProp.ValueType := mono_field_get_type(mono_class_get_field_from_name(mono_class_from_mono_type(lType), 'value'));
              //showMessage(mono_type_get_name(lProp.ValueType)+' = '+mono_type_get_name(tmonoconvert.DateTimeType));
            end;
          FPropList.Add(lProp);
        end;
      end;
      mp := mono_class_get_properties(lKlass, iter);
    end;
    lKlass := mono_class_get_parent(lKlass);
  end;
end;

function TNhibObject.NewItem: PMonoObject;
begin
  result := MonoJit.CreateMonoObject(FMonoClass, MonoDomain);
end;

function TNhibObject.ReadData(Prop: TMonoPropRec; obj: PMonoObject;
  Field: TField; Buffer: TRecordBuffer): boolean;
begin
  result := false;
  case Prop.PropType of
    MONO_TYPE_BOOLEAN: result := Read_Bool(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_I1: result := Read_I1(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_U1: result := Read_U1(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_I2: result := Read_I2(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_U2: result := Read_U2(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_I4: result := Read_I4(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_U4: result := Read_U4(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_I8: result := Read_I8(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_U8: result := Read_U8(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_R4: result := Read_R4(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_R8: result := Read_R8(Prop.getProc, obj, Buffer, false);
    MONO_TYPE_STRING: result := Read_String(Prop.getProc, obj, Buffer, Field.DataSize);
    MONO_TYPE_VALUETYPE: begin
        if Prop.MonoType = TMonoConvert.DateTimeType then
          result := Read_DateTime(Prop.getProc, obj, Buffer, false);
      end;

    MONO_TYPE_GENERICINST: begin
      case mono_type_get_type(Prop.ValueType) of
          MONO_TYPE_BOOLEAN: result := Read_Bool(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_I1: result := Read_I1(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_U1: result := Read_U1(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_I2: result := Read_I2(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_U2: result := Read_U2(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_I4: result := Read_I4(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_U4: result := Read_U4(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_I8: result := Read_I8(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_U8: result := Read_U8(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_R4: result := Read_R4(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_R8: result := Read_R8(Prop.getProc, obj, Buffer, true);
          MONO_TYPE_STRING: result := Read_String(Prop.getProc, obj, Buffer, Field.DataSize);
          MONO_TYPE_VALUETYPE: begin
              if Field.DataType = ftDateTime then  //if UTF8ToString(mono_type_get_name(prop.ValueType)) = 'System.DateTime' then
                result := Read_DateTime(Prop.getProc, obj, Buffer, true);
            end;
      end;

      end;

  end;
end;

function TNhibObject.Read_Bool(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: wordbool;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToBoolean(o);
  end
  else begin
    result := true;
    value := TMPropGetBool(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_DateTime(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  lBuff: Int64;
  ts: TTimeStamp;
  Data: TDateTimeRec;
  dt: TDateTime;
  e, o: PMonoObject;
begin
  result := true;
  e := nil;
  o := TMPropGetDT(proc)(obj, e);
  TestMonoException(e);
  if Nullable then
     if o = nil then
     begin
       result := false;
       exit;
     end;
  lBuff := PInt64(mono_object_unbox(o))^;

  dt := TMonoConvert.Int64ToDateTime(lBuff);
  ts := DateTimeToTimeStamp(dt);
  Data.DateTime:= TimeStampToMSecs(ts);
  Move(Data, Buffer^, SizeOf(TDateTimeRec));
end;

function TNhibObject.Read_I1(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: ShortInt;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToInt8(o);
  end
  else begin
    result := true;
    value := TMPropGetI1(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_I2(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: SmallInt;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToInt16(o);
  end
  else begin
    result := true;
    value := TMPropGetI2(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_I4(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: integer;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToInt(o);
  end
  else begin
    result := true;
    value := TMPropGetI4(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_I8(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: Int64;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToInt64(o);
  end
  else begin
    result := true;
    value := TMPropGetI8(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_R4(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: single;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToSingle(o);
  end
  else begin
    result := true;
    value := TMPropGetR4(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_R8(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: double;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToDouble(o);
  end
  else begin
    result := true;
    value := TMPropGetR8(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_String(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; aDataSize: integer): boolean;
var
  tmp: PMonoString;
  value: string;
  e: PMonoObject;
begin
  tmp := TMPropGetString(proc)(obj, e);
  TestMonoException(e);
  result := tmp <> nil;
  if result then
  begin
    value := TMonoConvert.MonoStrToString(tmp);
    StrLCopy(PChar(Buffer), PChar(value), aDataSize);
  end;
end;

function TNhibObject.Read_U1(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: Byte;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToUInt8(o);
  end
  else begin
    result := true;
    value := TMPropGetU1(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_U2(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: Word;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToUInt16(o);
  end
  else begin
    result := true;
    value := TMPropGetU2(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_U4(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: cardinal;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToUInt(o);
  end
  else begin
    result := true;
    value := TMPropGetU4(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

function TNhibObject.Read_U8(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean): boolean;
var
  value: uInt64;
  o, e: PMonoObject;
begin
  if Nullable then
  begin
    o := TMPropGetNullable(proc)(obj, e);
    TestMonoException(e);
    result := o <> nil;
    if result then
      value := TMonoConvert.MonoObjToUInt64(o);
  end
  else begin
    result := true;
    value := TMPropGetU8(proc)(obj, e);
    TestMonoException(e);
  end;
  if result then
    Move(value, Buffer^, SizeOf(value));
end;

procedure TNhibObject.setMonoClass(const Value: PMonoClass);
begin
  FMonoClass := Value;
  if Value <> nil then
    LoadProps
  else
    FPropList.Clear;
end;

procedure TNhibObject.TestMonoException(error: PMonoObject);
begin
  if error <> nil then
     raise Exception.Create(MonoJit.MonoExceptionMessage(error));
end;

procedure TNhibObject.WriteData(Prop: TMonoPropRec; obj: PMonoObject;
   Field: TField; Buffer: TRecordBuffer);
begin
  case Prop.PropType of
    MONO_TYPE_BOOLEAN: Write_Bool(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_I1: Write_I1(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_U1: Write_U1(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_I2: Write_I2(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_U2: Write_U2(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_I4: Write_I4(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_U4: Write_U4(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_I8: Write_I8(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_U8: Write_U8(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_R4: Write_R4(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_R8: Write_R8(Prop.setProc, obj, Buffer, false);
    MONO_TYPE_STRING: Write_String(Prop.setProc, obj, Buffer, Field.DataSize);
    MONO_TYPE_VALUETYPE: begin
        if Prop.MonoType = TMonoConvert.DateTimeType then
          Write_DateTime(Prop.setProc, obj, Buffer, false);
      end;
    MONO_TYPE_GENERICINST: begin
      case mono_type_get_type(Prop.ValueType) of
        MONO_TYPE_BOOLEAN: Write_Bool(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_I1: Write_I1(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_U1: Write_U1(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_I2: Write_I2(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_U2: Write_U2(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_I4: Write_I4(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_U4: Write_U4(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_I8: Write_I8(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_U8: Write_U8(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_R4: Write_R4(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_R8: Write_R8(Prop.setProc, obj, Buffer, true);
        MONO_TYPE_STRING: Write_String(Prop.setProc, obj, Buffer, Field.DataSize);
        MONO_TYPE_VALUETYPE: begin
            if Field.DataType = ftDateTime then //if UTF8ToString(mono_type_get_name(prop.ValueType)) = 'System.DateTime' then
              Write_DateTime(Prop.setProc, obj, Buffer, true);
          end;
      end;
    end;
  end;
end;

procedure TNhibObject.Write_Bool(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: wordbool;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.BooleanToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
    begin
      Move(Buffer^, value, SizeOf(value));
    end
    else
      value := false;
    e := nil;
    TMPropSetBool(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;


procedure TNhibObject.Write_DateTime(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  ts: TTimeStamp;
  Data: TDateTimeRec;
  dt: TDateTime;
  e: PMonoObject;
  o: PMonoObject;
begin
  if buffer <> nil then
  begin
    Move(Buffer^, Data, SizeOf(TDateTimeRec));
    ts := MSecsToTimeStamp(Data.DateTime);
    dt := TimeStampToDateTime(ts);
    o := TMonoConvert.DateTimeToMonoObj(dt);
  end
  else begin
    if Nullable then
      o := nil
    else begin
      ts := MSecsToTimeStamp(0);
      dt := TimeStampToDateTime(ts);
      o := TMonoConvert.DateTimeToMonoObj(dt);
    end;
  end;
  e := nil;
  TMPropSetDT(proc)(obj, o, e);
  TestMonoException(e);
end;

procedure TNhibObject.Write_I1(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: ShortInt;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.Int8ToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetI1(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_I2(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: SmallInt;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.Int16ToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetI2(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_I4(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: integer;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.IntToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetI4(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_I8(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: Int64;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.Int64ToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetI8(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_R4(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: single;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.SingleToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetR4(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_R8(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: double;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.DoubleToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetR8(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_String(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; aDataSize: integer);
var
  value: PMonoString;
  e: PMonoObject;
begin
  if proc = nil then exit;
  if Buffer = nil then
    value := nil
  else
    value := TMonoConvert.StringToMonoStr(PChar(Buffer), MonoDomain);
  TMPropSetString(proc)(obj, value, e);
  TestMonoException(e);
end;

procedure TNhibObject.Write_U1(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: Byte;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.UInt8ToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetU1(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_U2(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: word;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.UInt16ToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetU2(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_U4(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: cardinal;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.UIntToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetU4(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

procedure TNhibObject.Write_U8(proc: Pointer; obj: PMonoObject;
  Buffer: TRecordBuffer; Nullable: boolean);
var
  value: UInt64;
  o, e: PMonoObject;
begin
  if proc = nil then exit;
  if Nullable then
  begin
    if Buffer = nil then
      o := nil
    else begin
      Move(Buffer^, value, SizeOf(value));
      o := TMonoConvert.UInt64ToMonoObj(value, MonoDomain);
    end;
    TMPropSetNullable(proc)(obj, o, e);
    TestMonoException(e);
  end
  else begin
    if Buffer <> nil then
      Move(Buffer^, value, SizeOf(value))
    else
      value := 0;
    e := nil;
    TMPropSetU8(proc)(obj, value, e);
    TestMonoException(e);
  end;
end;

end.
